
	program xmodem50
c               MODEM7-type program to send and
c               receive files with checksums or CRC and automatic
c               re-transmission of bad blocks.
c               translated to VAX Fortran V3.0 from TMODEM.C
c               and enhanced according to time-outs and CRC
c               in XMODEM50.ASM
c               J.James Belonis II
c               Physics Hall FM-15
c               University of Washington
c               Seattle, WA 98195
c		(206) 545-8695
c
c  TMODEM.C written by Richard Conn, Eliot Moss, and Lauren
c   Weinstein
c
c  6/23/84 fixed improper READONLY, open .WRK files carriagecontrol='NONE'
c               made EAT routine continue eating 'til nothing left to eat.
c               increased text conversion capability to 500 character lines.
c		All known bugs are again fixed.
c  6/20/84 Version 5.53 increased filename ttyinlim's to 2 seconds which
c		greatly improved reliability of BATCH mode on heavy loaded VAX
c  5/18/84 Version 5.52 makes OPENs of OLD files READONLY so can work in
c		unowned directories
c  3/21/84 Version 5.51 replaces non-alphanumeric CP/M filename characters
c               by letter "A" when making a VAX filename,
c               commented out bad PRINT.
c  3/17/84 miscellaneous error messages added.
c  3/13/84 reserved space in cancel for eating characters to avoid access viol
C  3/13/84 increased RECVFILE data block timeout to 2 sec
c  2/27/84 Version 5.5 incorporated improvements by Steve Gill
c		GETACK  timeout and garbage loop and NAK, CAN detection
c		RECVFILE receive data block with timeout
c               TTYIN routine removed since replaced everywhere by TTYINLIM
c  1/25/84 properly placed CALL PASSALL in main program so not miss parity bit
c		in sendfn filename checksum
c  1/ 8/84 corrected last known bugs
c  1/ 2/84 Version 5.4 Added batch
c 12/31/83 Version 5.3 Added wildcard filenames(but not yet batch) and
c		streamlined option parsing and allowed CRC TEXT
c		found and fixed blank trim miscalculation
c		again (CONN apparently got old version)
c		XMODEM.LOG and XMODEM.WRK put in SYS$SCRATCH directory
c		(usually user's main) if can't open in current directory
c 12/27/83 Version 5.2 Speeded up SEND by doing only one TTYOUT call per block.
c	       no longer hogs CPU at 9600 baud (only 15-20 percent of cpu time)
c	       included QIO.DCK so only one file XMODEM.FOR is needed.
c  6/30/83 Modified, restructured, and VAX/VMS text file
c       conversion added by Richard Conn
c  1/17/83      touched up filename display and comments.
c  1/14/83      including timeouts and CTRL-X cancellation
c               and CRC capability
c
c  keeps a log file of error messages ( deletes it if no errors )
c  sets terminal driver to eightbit, passall
c  may need altypeahd if faster than 1200 baud works to 9600 baud at least.
c  needs PHY_IO privilege for passall ? apparently not on UWPhys VAX
c  nor on ACC VAX
c  many debugging statements left in as comments
 
c  declare variables

	include  '($rmsdef)'	! for LIB$FIND_FILE
       INTEGER*2 CHAN,STATUS(4)
       COMMON /QIO/ CHAN,STATUS

        character*128 line, filein, file, filec, filed, workf, options
        integer seploc, worklen, context, istat, length, lengthin
	logical openok, sendopt, recvopt, textopt
	logical getfn, sendfn

	logical batchopt,firstbatch
	common /batch/batchopt,firstbatch

        logical filedel
        common /filest/filedel
 
        integer errorcount
        common /err/errorcount
 
        integer high,low
	byte highbyte,lowbyte
        common /crcval/high,low
	equivalence (high,highbyte)
	equivalence (low,lowbyte)
 
        logical crc
        byte checksumbyte
        integer checksum
        common /checks/checksum,crc
        equivalence (checksum,checksumbyte)

        equivalence (ic,c)
 
c  define ascii characters
        parameter NUL=0         !ignore at SOH time
        parameter SOH=1         !start of header for sector
        parameter EOT=4         !end of transfer
        parameter ACK=6         !acknowlege sector
	parameter BEL=7		!bell warning if stupid
        parameter NAK=21        !not acknowlege sector
        parameter CAN=24        !cancel transfer
        parameter CRCCHAR='C'   !CRC indicating character
 
c  timeouts
        parameter respnaklim=10 !seconds to allow for response to NAK
        parameter naklim=10     !seconds to allow to receive first NAK
        parameter eotlim=10     !seconds to wait for EOT acknowlege
 
        parameter errlim=10     !max errors on a sector
 
c  define an exit routine to get control on all exits to turn off
c  passall and for debug cleanup
            external giveup
        call userex( giveup )
 
        print *,' XMODEM Version 5.53 6/23/84 [BATCH capable]'

c  assign terminal channel for QIO calls to send raw bytes.
        call sys$assign('TT',chan,,)
 
c  get command line
        call lib$get_foreign(line,'$_Command: ',,)
c  trim blanks
        do i=80,1,-1
                length=i
                if(line(i:i).NE.' ') goto 25
        enddo
c  no command on line
  25    continue

c  separate options from filename
c	print *,' length=',length
	seploc = index( line(1:length+1),' ' ) ! +1 so find end if one argument
c	print *,' seploc=',seploc
	options=line(1:seploc-1)
	filein=line(seploc+1:length)
c	print *,'options*',options(1:seploc-1),'*'
	lengthin=length-seploc
	if(lengthin.gt.0) then	! make sure not index infinite length string
	    if(  index( filein(1:lengthin), ' ' ) .ne. 0  ) then
c		print *,'filein*',filein(1:lengthin),'*'
c		print *,'index( filein,'' '')',index(filein(1:lengthin),' ')
		print *,' too many arguments'
		goto 150
	    endif
	endif
	 
        filedel=.false.
c  parse the options
	batchopt=.false.
	firstbatch=.false.
	textopt=.false.
	sendopt=.false.
	recvopt=.false.
	crc=.false.
	i=0
	if( index(options,'B').NE.0 ) then
		batchopt=.true.
		firstbatch=.true.
		i=i+1
	endif
	if( index(options,'T').NE.0 ) then
		textopt=.true.
		i=i+1
	endif
	if( index(options,'S').NE.0 ) then
		sendopt=.true.
		i=i+1
	endif
	if( index(options,'R').NE.0 ) then
		recvopt=.true.
		i=i+1
	endif
	if( index(options,'C').NE.0 ) then
		crc=.true.
		i=i+1
	endif

c  check options
	if(i.ne.seploc-1) then
		print *,char(BEL),' unsupported options ignored'
		print *
	endif
	if(sendopt.and.recvopt) then	! send and receive simultaneously
		print *,' incompatible options SEND and RECEIVE'
		call exit
	endif
	if(  .not.(recvopt.and.batchopt) .and. lengthin.le.0 ) then
c  no options or no filename
		print *,' insufficient arguments'
		goto 150
	endif
	if( lengthin.gt.0 .and. (recvopt.and.batchopt) ) then
		print *,' filename ignored on batch receive',char(BEL)
	endif


	context=0	! initial FAB pointer for LIB$FILE_FIND
        call passall(CHAN,.TRUE.)	! turn on passall so typeahead
					! not strip parity on unsolicited chars
c  BATCH option loop comes here
100	continue	!GOTO at end comes here for next filename

c  open separate log file for each transferred file.
	openok=.true.
	workf='XMODEM.WRK'
	worklen=10
	open(8,file='XMODEM.LOG', iostat=istat,
     1                         carriagecontrol='LIST',status='NEW')
	if(istat.ne.0) then
	    if(firstbatch) then
		print *,' Can''t open XMODEM.LOG in this directory,'
		print *,' putting it in your main directory.',char(BEL)
            endif
            open(8,file='SYS$SCRATCH:XMODEM.LOG',
     1                         carriagecontrol='LIST',status='NEW')
	    openok=.false.
	    workf='SYS$SCRATCH:XMODEM.WRK'
	    worklen=22      ! number of chars in file name
	endif

	if(recvopt) then		! wildcards done on other computer
		if(.not.batchopt) then
			file=filein
			length=lengthin
		endif
	else	! sending, need name(s)
		istat=lib$find_file(filein(1:lengthin),file,context,,)
		if(istat.eq.rms$_nmf) then	! no more files
			if(batchopt) then !await rcvr's request for filename
				call waitnlp(80) 
				call ttyout(ACK,1)	! tell yes file
			endif
			call ttyout(EOT,1)	! tell other computer no more
						! it receives EOT as first
						! char of expected filename
c		        print *,' All transfers complete.'
	       	 	write(8,*) ' All transfers complete.'
			close(8,dispose='delete')	! .LOG file
			call exit
		endif
		if(.not.istat) then
			if(firstbatch.or..not.batchopt) then
				print *,' LIB$FILE_FIND error'
			endif
			write(8,*) ' LIB$FILE_FIND error'
			call cancel
		endif
c  trim blanks
	        do i=128,1,-1
	                length=i
	                if(file(i:i).NE.' ') goto 125
	        enddo
c		print *,' couldn''t happen, filename blank'
		write(8,*) ' couldn''t happen, filename blank'
 125    	continue

	endif

	if( sendopt ) then
c  send
		if(batchopt) then
c                                       make a reasonable filename for CP/M
			call cleansfn( file(1:length),filec,leng)
			if(firstbatch) then
			  print *,' sending BATCH mode, please run receiver'
			endif
		endif
		if(textopt) then
			if(.not.batchopt) then	! not batch
		                print *,' Sending Text File: ',file(1:length)
				print *,' Do not run your receiver yet.'
			endif
	                call vtoc( file(1:length), workf(1:worklen) )
c			print *,' file converted'
c			write(8,*) ' file converted'
	                filedel=.true.  !delete working file when done
			if(batchopt) call sendfn( filec(1:leng) )
	                call sendfile( workf(1:worklen) )
		else	! not text
			if(.not.batchopt) then
	                	print *,' Sending File: ',file(1:length)
			else	! batchopt
				call sendfn( filec(1:leng) )
			endif
                	call sendfile( file(1:length) )
		endif		

	elseif(recvopt) then
c  receive
		if(batchopt) then
			if(firstbatch) then
			   print *, ' Receiving BATCH please run sender'
			endif
			if(.not.getfn(filed,leng)) then
				call ttyout(EOT,1)
c				print *,' All transfers complete.'
				write(8,*) ' All transfers complete.'
				close(8,dispose='delete')	! log file
				call exit
			endif
			call cleangfn(filed(1:leng),file,length)
		endif
		if(textopt) then
			if(.not.batchopt) then
		                print *,' Receiving Text File: ',file(1:length)
			endif
	                call recvfile( workf(1:worklen) )
	                filedel=.true.  !delete working file when done
	                call ctov( workf(1:worklen), file(1:length) )
		else	! not text
			if(.not.batchopt) then
		                print *,' Receiving File: ',file(1:length)
			endif
	                call recvfile( file(1:length) )
		endif
	else
c  else bad command
150	        print *,' Invalid XMODEM Command --'
	        print *,' Usage: XMODEM  <SRCTB>  <file> '
	        print *,'   S = Send, R = Receive, C = Use CRCs, B = Batch'
	        print *,'   T = Convert text files to/from CP/M or VAX/VMS'
	endif

	if( batchopt ) then
		firstbatch=.false.	! don't print informational messages
					! from now on
		goto 100		! get next filename
	endif

200     call exit	! should probably have a unified exit here ??

        end
c------------------------------------------------------
	subroutine cleansfn(file,fileclean,length)
	character*(*) file, fileclean
	integer length
c  clean send file name
c  remove too-specific parts of filename (directory and version)
c  and make understandable by CP/M  11 char no dot, last 3 for type

	fileclean=' '
	start=index( file,']' )+1
	end=index( file, ';' )-1
	dot = start-1 + index( file(start:end),'.' )	! VMS guarantees a dot
	if(start.ne.dot) fileclean(1:)=file(start:dot-1)
	if(dot.ne.end) fileclean(9:)=file(dot+1:end)
	! note: may overwrite last char of vax 9 char filename before dot
	length=11
	return

	end

c-------------------------------------
	subroutine sendfn(file)
	character*(*) file
c  sends name for batch checksummed send				

	byte c
	integer ic
	equivalence (ic,c)

        logical ttyinlim

        logical crc
        byte checksumbyte
        integer checksum
        common /checks/checksum,crc
        equivalence (checksum,checksumbyte)

	parameter BDNMCH=117	! badname character 'u'
	parameter OKNMCH=6	! good name character
	parameter ACK=6		! acknowlege character
	parameter EOF=26	! filename terminator

100	continue
c	print *,' Awaiting name NAK'
c	write(8,*) ' Awaiting name NAK'
	call waitnlp(80)	! await NAK
	call ttyout(ACK,1)	! tell receiver a filename follows

	checksum=0
c	print *,file
c	write(8,*) file
	do i=1,len(file)
		c=ichar( file(i:i) )
c		print *, ' filename character=',c
c		write(8,*) ' filename character=',c
		checksum=checksum+c
c		print *,' checksum=',checksum
c		write(8,*) ' checksum=',checksum
		call ttyout(c,1)
200		if( .not.ttyinlim(c,1,2) ) then
c			print *,' timeout during name'
			write(8,*) ' timeout during name'
			goto 300
		endif
c		print *,' ACK char received decimal=',c
c		write(8,*) ' ACK char received decimal=',c
		if(c.ne.ACK) goto 200	! let it time out if bad   eat chars ?
	enddo
c	print *,' EOF end of filename'
c	write(8,*) ' EOF end of filename'
	checksum=checksum+EOF
	call ttyout(EOF,1)
	if( .not.ttyinlim(c,1,2) ) then	! checksum from receiver (MODEM765.ASM
					! did not check for timeout)
c		print *,' timeout awaiting checksum in sendfn'
		write(8,*) ' timeout awaiting checksum in sendfn'
		goto 300
	endif
	if( checksumbyte.ne.c ) then
c  bad filename transmission
c		print *,' checksum,byte,c=',checksum,checksumbyte,c
		write(8,*) ' checksum,byte,c='
		write(8,'(3z10)') checksum,checksumbyte,c
300		continue
c		print *,' BDNMCH = u'
c		write(8,*) ' BDNMCH = u'
		call ttyout(BDNMCH,1)	! lower case u (but receiver
					! only cares that it was not ACK)
c		print *,' receiver better NAK now to start again'
		goto 100
	endif
c	print *,' filename sent ok'
c	write(8,*) ' filename sent ok'
	call ttyout(OKNMCH,1)	! ACK
	return
	end
c---------------------------------------------------------
	subroutine waitnlp(sec)
	integer sec
c  Await NAK, Cancel if not here in sec seconds, or if CAN, ignore garbage

	integer count
        logical ttyinlim
	byte c
	parameter NAK=21
	parameter CAN=24

	count=0
100	if( .not.ttyinlim(c,1,1) ) then	! timeout
		count=count+1
c		print *,' waitnlp passed limit'
		write(8,*) ' waitnlp passed limit'
		if(count.ge.sec) call cancel	! passed limit
		goto 100
	elseif( c.eq.CAN ) then
c		print *,' waitnlp canceled'
		write(8,*)' waitnlp canceled'
		call cancel
	elseif( c.ne.NAK ) then		! ignore garbage
c		print *,' waitnlp not NAK, got decimal=',c
		write(8,*) ' waitnlp not NAK, got decimal=',c
		goto 100
	endif
c  must have gotten NAK
	return

	end
c---------------------------------------
	logical function getfn(file,length)
	character*(*) file
	integer length
c  get the characters of the batch mode filename  (return false if no more)
c  note: must be declared in callers too.

        logical ttyinlim, hsnak

	integer ic	! so char(ic) works
	byte c

        logical crc
        byte checksumbyte
        integer checksum
        common /checks/checksum,crc
        equivalence (checksum,checksumbyte)

	parameter EOT=4		! end of batch transfer
	parameter ACK=6		! acknowledge character
	parameter OKNMCH=6	! OK name character   ACK
	parameter EOF=26	! end of filename

	getfn=.true.
	flen=len(file)
100	checksum=0
	length=0
	file=' '	! blank filename
c  handshake to make sure synchronized
150	if( .not.hsnak() ) goto 150	! may hang 'til CTRL-X

200	if( .not.ttyinlim(ic,1,2) ) then
c		print *,' Time out receiving filename=',file
		write(8,*) ' Time out receiving filename=',file
		goto 100	! give up and restart handshaking
	endif
	length=length+1
	file(length:length)=char(ic)
c	print *,' filename char=',ic
c	write(8,*) ' filename char=',ic
c	print *,' filename=',file(1:length)
c	write(8,*) ' filename=',file(1:length)
	checksum=checksum+ic

	if(ic.eq.EOT) then	! no more filenames
c		write(8,*) ' getfn got EOT'
		getfn=.false.
		return
	endif

	if(ic.eq.EOF) then
		length=length-1
c		print *,' getfn got EOF'
c		write(8,*) ' getfn got EOF'
c		print *,file(1:length)
c		write(8,*) file(1:length)
		call ttyout(checksumbyte,1)	! send calculated checksum
		if(.not.ttyinlim(c,1,2) ) then	! get verification of checksum
						! MODEM765 had no timeout check
c			print *,' timeout awaiting checksum ok'
			write(8,*) ' timeout awaiting checksum ok'
			goto 100	! restart handshake
		endif
		if(c.eq.OKNMCH) return

c		print *,' Checksum error, verification c=',c
		write(8,*) ' Checksum error, verification c=',c
		goto 100	! restart handshaking
	endif

	if(length.ge.flen) then
c		print *,' Too many characters in filename'
		write(8,*) ' Too many characters in filename'
		goto 100	! start again at NAK
	endif

	call ttyout(ACK,1)
	goto 200	! get next char

	end

c--------------------------------------
	logical function hsnak()
c  true if get ACK in response to NAK, c returns null if timeout  ???
c  note: must be declared in callers too.

	byte c
	logical ttyinlim
	parameter ACK=6
	parameter CAN=24
	parameter NAK=21

	call ttyout(NAK,1)
c  checking for CAN is the only way to get out of the loop that
c  calls hsnak
	if( .not.ttyinlim(c,1,2) ) then	! timeout don't care what c is
		write(8,*) ' hsnak timeout'
		hsnak=.false.
	elseif(c.eq.ACK) then
		hsnak=.true.
c		print *,' hsnak got ACK'
c		write(8,*) ' hsnak got ACK'
	elseif(c.eq.CAN) then
		write(8,*) ' hsnak canceled'
		call cancel
c       else	! bad character, ignore
	endif
	return

	end
c------------------------------------------------------
	subroutine cleangfn(file,fileclean,length)
	character*(*) file, fileclean
	integer length
c  clean get file name
c  and make understandable by VAX 13 char with dot, last 3 for type
c  also replaces non-alphanumeric by "A"
	integer leng

	leng=index(file//' ',' ')-1	! add blank in case none in filename
c	print *,' leng=',leng
	leng=min(leng,8)	! in case filename and type run together
c	print *,' leng=',leng
	fileclean(1:)=file(1:leng)//'.'//file(9:)
	length=index(fileclean,' ')-1
	do i=1,leng
		if(  (fileclean(i:i).ge.'A' .and. fileclean(i:i).le.'Z')
	1	  .or.
	1	  (fileclean(i:i).ge.'0' .and. fileclean(i:i).le.'9')  )
	1		then
c  do nothing
		else	! not alphanumeric, replace by legal character
			fileclean(i:i)='A'
		endif
	enddo
	do i=leng+2,length
		if(  (fileclean(i:i).ge.'A' .and. fileclean(i:i).le.'Z')
	1	  .or.
	1	  (fileclean(i:i).ge.'0' .and. fileclean(i:i).le.'9')  )
	1		 then
c  do nothing
		else	! not alphanumeric, replace by legal character
			fileclean(i:i)='A'
		endif
	enddo
c	print *,' length=',length
c	write(8,*) ' cleaned filename VAX form*',fileclean(1:length),'*'
	return
	end
c----------------------------------------------------------------
c  send file
        subroutine sendfile(file)
 
c  declare variables

       INTEGER*2 CHAN,STATUS(4)
       COMMON /QIO/ CHAN,STATUS

        character*(*) file

        byte sectorread(128), sector(130), send(133), c
	equivalence (send(4), sector(1), sectorread(1) )

        integer nakwait, stat, ic
        logical ttyinlim
        logical charintime, acked
 
	logical batchopt, firstbatch
	common /batch/batchopt,firstbatch

        logical filedel
        common /filest/filedel
 
	integer blocknumber
	byte blockbyte
	equivalence (blocknumber,blockbyte)

	integer notblocknumber
	byte notblockbyte
	equivalence (notblocknumber,notblockbyte)

        integer errorcount
        common /err/errorcount
 
        integer high,low
	byte highbyte,lowbyte
        common /crcval/high,low
	equivalence (high,highbyte)
	equivalence (low,lowbyte)
 
        logical crc
	byte checksumbyte
        integer checksum
        common /checks/checksum,crc
        equivalence (checksum,checksumbyte)

        equivalence (ic,c)
 
c  define ASCII characters
        parameter NUL=0
        parameter SOH=1
        parameter EOT=4
        parameter ACK=6
        parameter NAK=21
        parameter CAN=24
        parameter CRCCHAR='C'
c  timeouts
        parameter respnaklim=10
        parameter naklim=10
        parameter eotlim=10
        parameter errlim=10
 
	if(filedel) then	! will close(9,disp='delete') so can't readonly
	        open(9,name=file,iostat=stat,status='OLD')
c     1             carriagecontrol='NONE',recordtype='FIXED',recl=128)
	else	! should not delete, so readonly is ok
	        open(9,name=file,iostat=stat,status='OLD',readonly)
c     1             carriagecontrol='NONE',recordtype='FIXED',recl=128)
	endif
 
        if(stat) then
		if(.not.batchopt) then
	                print *,'Can''t open ',file,' for send.'
		endif
                write(8,*) 'Can''t open ',file,' for send.'
                call cancel
        endif
	if( .not.batchopt ) then
	        print *,file,' Open -- Please Run Your Receiver --'
	        print *
	endif
        errorcount=0
        blocknumber=1
        nakwait=0
 
c  await first NAK (or 'C') indicating receiver is ready
  200   charintime=ttyinlim(c,1,naklim)         ! return NUL if timeout
c        print *,' first NAK character=',c
c        write(8,*) ' character=',c
        if( .NOT.charintime ) then
		write(8,*) 'initial NAK or C timeout, trying again'
                nakwait=nakwait+1
c  give the turkey 80 seconds to figure out how to receive a file
                if(nakwait.ge.80/naklim) call cancel
                goto 200
        elseif(c.EQ.NAK) then
                crc=.false.
c		print *,' CHECKSUM mode'
		write(8,*) ' CHECKSUM mode'
        elseif(c.EQ.CRCCHAR) then
                crc=.true.
c		print *,' CRC mode'
		write(8,*) ' CRC mode'
        elseif(c.EQ.CAN) then
                call cancel
        else
c  unrecognized character
		write(8,*) 'unrecognized first NAK=',c
                nakwait=nakwait+1
                if(nakwait.ge.80/naklim) call cancel
                goto 200
        endif
 
  300   continue
c  send new sector
c  use equivalence so not need to do inefficient implicit do loop in read
        read(9,1000,end=500) sectorread
 1000   format(128a)
        errorcount=0
c        print *,' sector as read',sector
c        write(8,*) ' sector as read',sector
  400   continue
c  send sector
c        print *,' SOH '
c	write(8,*) ' SOH'
        send(1)=SOH
c  note: equivalence used for fast integer to byte conversion
c		without byte overflow problems
        send(2)=blockbyte
	notblocknumber=not(blocknumber)
        send(3)=notblockbyte
c        print *,' blocknumber=',blocknumber
c        write(8,*) ' blocknumber=',blocknumber
 
c  sector already in sending buffer    done by equivalence

        checksum=0
        call clrcrc
c  calc checksum or crc
        if(crc) then
c		write(8,*) ' CRC mode'
c  put all bytes + two finishing zero bytes through updcrc
                sector(129)=0
                sector(130)=0
                call updcrc( sector,130 )
                send(132)=highbyte
                send(133)=lowbyte
c		write(8,*) 'highbyte,lowbyte'
c		write(8,'(2z10)') highbyte,lowbyte
c  actually send
		call ttyout(send,133)
        else
c		write(8,*) 'CHECKSUM mode'
                do i=1,128
                        checksum=checksum+sector(i)
                enddo
c  this sends low order byte of checksum
                send(132)=checksumbyte
c                print *,' checksumbyte ',checksumbyte
c                write(8,*) ' checksumbyte ',checksumbyte
		call ttyout(send,132)
        endif
 
c  sector sent, see if receiver acknowleges
c  getack attempts to get ACK
c  if not, repeat sector
c        print *, ' should wait for ACK 10 seconds'
c        write(8,*) ' should wait for ACK 10 seconds'

        call getack(acked)
c        print *, ' getack returned=',acked
c        write(8,*) ' getack returned=',acked
        if(.NOT.acked) goto 400
 
c  ACK received, send next sector
        blocknumber=blocknumber+1
        goto 300
 
c  end of file during read.  finish up sending.
  500   continue
        call ttyout(EOT,1)
c  getack attempts to get ACK up to errlim times
        call getack(acked)
        if( .NOT.acked ) goto 500

c        print *,' This file Sending complete.'
        write(8,*) ' This file Sending complete.'
        if (filedel) then
                close(9,dispose='DELETE')
        else
                close(9)
        endif
        close(8,dispose='DELETE')	! the .LOG file
        return
        end
 
c----------------------------------------------------------------
c  receive file
        subroutine recvfile(file)
 
c  declare variables

       INTEGER*2 CHAN,STATUS(4)
       COMMON /QIO/ CHAN,STATUS

        character*(*) file
        byte c, notc, ck
        integer blocknumber, inotc, notnotc, secbytes, stat
        integer testblock, testprev, ic
        logical ttyinlim
        logical charintime, firstsoh

	byte sector(130),sectorwrite(128)
	equivalence (sector,sectorwrite)

	logical batchopt,firstbatch
	common /batch/batchopt,firstbatch
 
        integer errorcount
        common /err/errorcount
 
        integer high,low
	byte highbyte,lowbyte
        common /crcval/high,low
	equivalence (high,highbyte)
	equivalence (low,lowbyte)
 
        logical crc
        byte checksumbyte
        integer checksum
        common /checks/checksum,crc
        equivalence (checksum,checksumbyte)

        equivalence (ic,c)
 
c  define ASCII characters
        parameter NUL=0
        parameter SOH=1
        parameter EOT=4
        parameter ACK=6
        parameter NAK=21
        parameter CAN=24
        parameter CRCCHAR='C'
c  timeouts
        parameter respnaklim=10
        parameter naklim=10
        parameter eotlim=10
        parameter errlim=10
	parameter datalim=2	! timeout for data block receive
				! 1 second wouldn't work on moderately loaded
				! VAX, more may be necessary if heavily loaded
 
        open(7,name=file,recl=128,status='NEW',iostat=stat,
     1          carriagecontrol='NONE',recordtype='FIXED')
        if(stat) then
		if(batchopt) then
c	                print *,' Can''t open ',file,' for receive.'	
		else
	                print *,' Can''t open ',file,' for receive.'
		endif
                write(8,*) ' Can''t open ',file,' for receive.'
		call cancel
        endif

	if(.not.batchopt) then
	        print *,' Please Send Your File --'
	        print *
	endif
 
        if(crc) then
                secbytes=130
        else			! checksum mode
                secbytes=129
        endif
 
        firstsoh=.false.
        errorcount=0
        blocknumber=1
 
c  start the sender by letting ttyinlim time-out in getack routine
c  so it sends a NAK or C
        goto 999
 
  800   continue
c        write(8,*) ' ready for SOH'
c  must allow enough time for other's disk read (xmodem50.asm allows 10sec)
        charintime=ttyinlim(c,1,respnaklim)
c  if no char for a while, try NAK or C again
        if( .NOT.charintime ) then
c                print *,' no response to NAK or C, trying again'
                write(8,*) ' no response to NAK or C, trying again'
                goto 999
        endif
c  else received a char so see what it is
        if(c.eq.NUL) goto 800   ! ignore nulls here for compatablity with old
                                ! versions of modem7
        if(c.EQ.CAN) then
c                print *,' Canceled.  Aborting.'
                write(8,*) ' Canceled.  Aborting.'
                call exit
        endif

c        print *,' EOT or SOH character=',c
c        write(8,*) ' EOT or SOH character=',c
         if(c.NE.EOT) then
                if(c.NE.SOH) then
c                        print *,' Not SOH, was decimal ',c
                        write(8,*) ' Not SOH, was decimal ',c
                        goto 999
                endif
                firstsoh=.true.
 
c  character was SOH to indicate start of header
c  get block number and complement
                charintime=ttyinlim(c,1,1)
		if(.not.charintime) then
c			print *,' timeout awaiting block number'
			write(8,*) ' timeout awaiting block number'
			goto 999
		endif
c                print *,' block=',c
c               write(8,*) ' block=',c
 
                charintime=ttyinlim(notc,1,1)
		if(.not.charintime) then
c			print *,' timeout awaiting block complement'
			write(8,*) ' timeout awaiting block complement'
			goto 999
		endif
c                print *,' block complement=',notc
c                write(8,*) ' block complement=',notc
                inotc=notc      ! make integer for "not" function
                notnotc=iand( not(inotc),255 )  ! mask back to byte
 
c  c is low order byte of ic via equivalence statement
                if(ic.NE.notnotc) then
c                        print *,' block check bad.'
                        write(8,*) ' block check bad.'
                        goto 999
                endif
c  block number valid but not yet checked against expected
 
c  clear checksum and CRC
                checksum=0
                call clrcrc
 
c  receive the sector and checksum bytes in one call (for speed) and to
c  keep from hogging VAX cpu time at high baud rates.
c  secbytes is 129 for checksum, 130 for CRC
		charintime=ttyinlim(sector,secbytes,datalim)
C check for time out
		if(.not.charintime) then
c			print *,' Timeout on data block read'
			write (8,*) ' Timeout on data block read'
			goto 999
		endif
 
                if(crc) then
c  put data AND CRC bytes through updcrc
                        call updcrc(sector,secbytes)
c  if result non-zero, BAD.
                        if(highbyte.NE.0 .OR.
     1                     lowbyte.NE.0     ) then
c                                print *,' CRC, high,low='
                                write(8,*) ' CRC, high,low='
c                                print 3000, highbyte,lowbyte
                                write(8,3000) highbyte,lowbyte
 3000                           format(2z10)
                                goto 999
                        endif
                else
c  don't add received checksum byte to checksum
                        do i=1,secbytes-1
                                checksum=checksum+sector(i)
                        enddo
                        ck=sector(129)
c                        print 2100, ck
c                        write(8,2100) ck
 
c                        print 2100, checksum
c                        write(8,2100) checksum
c                        print 2100, checksumbyte
c                        write(8,2100) checksumbyte
c 2100                   format(' checksum=',z10)
                         if( checksumbyte.NE.ck ) then
                                write(8,*) ' bad checksum'
                                goto 999
                        endif
                endif
 
c  received OK so we can believe the block number, see which block it was
c  mask it to be one byte
                testblock=iand(blocknumber,255)
                testprev=iand( blocknumber-1 ,255)
                if( ic.EQ.testprev) then
c                        print *, ' prev. block again, out of synch'
                        write(8,*) ' prev. block again, out of synch'
c  already have this block so don't write it, but ACK anyway to resynchronize
                        goto 985
                elseif( ic.NE.testblock ) then
c                        print *, ' block number bad.'
                        write(8,*) ' block number bad.'
                        goto 999
                endif
c  else was expected block
 
c  write before acknowlege so not have to listen while write.
c  equivalence so not need inefficient implicit do loop
                write(7,2000,err=900) sectorwrite
 2000           format(128a)
                goto 975

  900           write(8,*) ' Can''t write sector. Aborting.'
c                print *, ' Can''t write sector. Aborting.'
                call cancel
 
  975           continue
c  received sector ok, wrote it ok, so acknowlege it to request next.
                blocknumber=blocknumber+1
c  comes here if re-received the previous sector
  985           continue
                errorcount=0
c                print *, ' ACKing, sector was ok.'
c                write(8,*) ' ACKing, sector was ok.'
                call ttyout(ACK,1)
                goto 800
 
c  else error so eat garbage in case out of synch and try again
  999           continue
                call eat
c                print *, ' receive error NAK, block=',blocknumber
                write(8,*) ' receive error NAK, block=',blocknumber
                if(crc.AND..NOT.firstsoh) then
c  keep sending 'C'  'til receive first SOH
                        call ttyout(CRCCHAR,1)
                else
                        call ttyout(NAK,1)
                endif
                errorcount=errorcount+1
  998           if(errorcount.GE.errlim) then
c                        print *,' Unable to receive block. Aborting.'
                        write(8,*) ' Not receive block. Aborting.'
c  delete incompletely received file
                        close(7,dispose='DELETE')
                        call cancel
                endif
c  retry
                goto 800
        endif
 
c  EOT received instead of SOH so file done.
c  should keep sending ACK 'til no more EOT's ?
        close(9)
        close(7)
        call ttyout(ACK,1)
        call ttyout(ACK,1)
        call ttyout(ACK,1)
 
        write(8,*) ' Completed.'
c       print *,   ' Completed.'
c  transfer ok, so delete the error log file.
        close(8,dispose='DELETE')
        return
        end
 
c-------------------------------------------------------------
        subroutine ctov(input,output)
c  convert file of XMODEM 128 byte records with embedded <CR><LF>
c  marking end-of-line and CTRL-Z marking end-of-file
c  to carriage-control=LIST (normal VAX editable file)
 
	parameter linelen=500	! if longer lines needed, change this
				! and the 'line' declaration below

        character*80 input,output
        character*500 line
        character*1 CR,LF,recchar
        logical eof, eol
	integer len
 
        logical filedel
        common /filest/filedel
 
	len=0
	eof=.false.
	eol=.false.
        CR=char(13)
        LF=char(10)
 
	if(filedel) then	! can't readonly since close(9,disp='delete')
	        open(9,file=input,status='OLD')
	else
	        open(9,file=input,status='OLD',readonly)
	endif
c  set maximum output record length (fortran default is 133)
        open(7,file=output,status='NEW',carriagecontrol='LIST',
     1							recl=linelen)
 
c  getchar (read new record if no input characters left)
c  if EOF on input, write line and exit
c  if CR then
c    if getchar LF then write line
c    else put back char and putchar CR into line (error if too long)
c    endif
c  else putchar (write error message if line too long)
c  endif
c  loop
 
  100   call getc(recchar,eof,eol)
        if(eof) goto 200
        if(recchar.eq.CR) then
c       	PRINT *,' CR'
                call getc(recchar,eof)
                if(eof.or.recchar.ne.LF) then
                        call putback
 
                        len=len+1
                        if(len.ge.linelen+1)
     1                                 write(8,*)' Out line too long.'
c       		print *,' too long line=',line
                        line(len:len)=recchar
                else
c  was LF
c       		PRINT *,' LEN=',LEN
c       		print *,' after LF, line=',line(1:len)
                        write(7,2000) line(1:len)
                        len=0
                endif
        else
c  not CR, was "ordinary" character
                len=len+1
                if(len.ge.linelen+1) then
                        write(8,*)' Out line too long.'
c                       PRINT *,' LINE=',LINE(1:len)
		else
	                line(len:len)=recchar
                endif
        endif
 
        go to 100
 
c  flush last line and exit
  200   continue
        if(len.gt.0) then
                write(7,2000) line(1:len)
 2000           format(a)
		len=0
        endif
        if (filedel) then
                close(9,dispose='DELETE')
        else
                close(9)
        endif
        close(7)
        return
        end
c------------------------------------------
        subroutine getc(c,eof)
        character*1 c
        logical eof
c  get character from a CP/M text file
c  point to next character in record (read record if necessary)
        character*1 CTRLZ

        integer point
        character*128 record
        common /reccom/point,record
        data point/0/

        logical firsttime
	common /getccom/firsttime
        data firsttime/.true./
 
        CTRLZ=char(26)
        point=point+1
        if( firsttime .or. (point.gt.128) ) then
                firsttime=.false.
  100           read(9,1000,end=200) record
 1000           format(a)
c               PRINT *,RECORD
                point=1
        endif
c  strip parity in case CP/M file had it
        c=char(iand(ichar(record(point:point)),127))
        if(c.eq.CTRLZ) goto 200		! end of CP/M text file
	return
 
c  end of file
  200   eof=.true.
	firsttime=.true.	! ready for next file
	point=0
        return
        end
c----------------------------------------------
	subroutine putback
c  point to previous input character so this character will be getchar result
c  even works if 1st char of record
	integer point
	character*128 record
	common /reccom/point,record

	point=point-1
	return
	end
c-------------------------------------------------------------
        subroutine vtoc(input,output)
c  convert VAX text file to
c  file of XMODEM 128 byte records with embedded <CR><LF>
 
        character*80 input,output
        character*1 CR,LF,c
        logical eof,eol

	eof=.false.
	eol=.false. 
        CR=char(13)
        LF=char(10)
 
        open(9,file=input,status='OLD',READONLY)
        open(7,file=output,status='NEW',carriagecontrol='NONE',
     1                               recl=128,recordtype='FIXED')
 
c  getchar (read new line if no input characters left)
c  putchar ( output record if full, close if EOF )
c  if EOL on input, putchar CR putchar LF (output record if full)
c  loop
 
  100   call getv(c,eof,eol)
        if(.not.eol) then
                call putchar(c,eof)
                if(eof) then
                        return
                endif
        else
c  end of line
                call putchar(CR,eof)
                call putchar(LF,eof)
                eol=.false.
                if(eof) then
                        return
                endif
        endif
        go to 100
 
        end
c------------------------------------------
        subroutine putchar(c,eof)
        character*1 c
        logical eof
c  put character into record (write record if necessary)
c  if eof, fills out rest of record with CTRL-Z's and exits
        character*1 CTRLZ

        integer point
        character*128 record
        common /reccom/point,record
        data point/0/
 
        if(eof) goto 200
        point=point+1
c  strip parity in case VAX file had it
        record(point:point)=char(iand(ichar(c),127))
c       print *,' record(point:point)=',record(point:point)
c       print *,' point=',point
   50   if(point.ge.128) then
c               print *,' record=',record
  100           write(7,1000) record
 1000           format(a)
                point=0
        endif
        return
 
c  EOF fill record with 26's (CTRL-Z, CP/M end of file mark for ASCII)
c  output last record and exit
  200   continue
c       print *,' in putchar EOF section'
        CTRLZ=char(26)
        do i=point+1,128
                record(i:i)=CTRLZ
        enddo
c       print *,' record=',record
        write(7,1000) record
        close(9)
        close(7)
	point=0		! ready for next file
        return
        end
c-------------------------------------------
        subroutine getv(inchar,eof,eol)
        character*1 inchar
        logical eof,eol
c  get character from input line (read line if necessary)
c  returns character and eol=.true. if no more char on line
c  returns eof if end of file (no character)
        character*255 line
        integer len, pos
        logical firsttime
        common/lincom/pos,len,line
        data pos/0/
 
        if(pos.eq.0) then
                read(9,1000,end=100)len,line(1:len)
 1000           format(q,a)
c               print *,' line=',line
        endif
        pos=pos+1
        if(pos.gt.len) then
                eol=.true.
                pos=0
                return
        endif
c       print *,' pos=',pos,' line(1:pos)=',line(1:pos)
c       print *,' line(pos:pos)=',line(pos:pos)
        inchar=line(pos:pos)
c       print *,' pos,char',pos,inchar
        return
c  EOF
  100	continue
	eof=.true.
	return
	end
c-----------------------------------------------------------
	subroutine clrcrc
c  clears CRC
        integer high,low
	byte highbyte,lowbyte
        common /crcval/high,low
	equivalence (high,highbyte)
	equivalence (low,lowbyte)

	high=0
	low=0
	return
	end
c-----------------------------------------------------------
	subroutine updcrc(bbyte,n)
	byte bbyte(*)
	integer n
c  updates the Cyclic Redundancy Code
c  uses x^16 + x^12 + x^5 + 1 as recommended by CCITT
c	and as used by CRCSUBS version 1.20 for 8080 microprocessor
c	and incorporated into the MODEM7 protocol of the CP/M user's group
c
c  during sending:
c  call clrcrc
c  call updcrc   for each byte
c  call fincrc   to finish (or just put 2 extra zero bytes through updcrc)
c  result to send is low byte of high and low in that order.
c
c  during reception:
c  call clrcrc
c  call updcrc   all bytes PLUS the two received CRC bytes must be passed
c       to this routine
c       then zero in high and low means good checksum
c
c  see Computer Networks, Andrew S. Tanenbaum, Prentiss-Hall, 1981
c
c  must declare integer to allow shifting
	integer byte
	integer bit,bitl,bith

        integer high,low
	byte highbyte,lowbyte
        common /crcval/high,low
	equivalence (high,highbyte)
	equivalence (low,lowbyte)

c	write(8,*) ' inside updcrc'
	do i=1,n
c		write(8,*) 'high,low,byte'
c		write(8,1000) high,low,bbyte
c1000		format(3z10)
		byte=bbyte(i)

		do j=1,8
c  get high bits of bytes so we don't lose them when shift
c  positive is left shift
			bit =ishft( iand(128,byte), -7)
			bitl=ishft( iand(128,low),  -7)
			bith=ishft( iand(128,high), -7)
c			write(8,*) 'bit,bitl,bith'
c			write(8,1000) bit,bitl,bith
c  get ready for next iteration
			newbyte=ishft(byte,1)
			byte=newbyte		! introduced dummy variable newbyte
						! to avoid "access violation"
c			write(8,*) ' byte ready for next iteration'
c			write(8,1000) byte
c  shift those bits in
			low =ishft(low ,1)+bit
			high=ishft(high,1)+bitl
c			write(8,*),' high,low after shifting bits in'
c			write(8,1000) high,low 

			if(bith.eq.1) then
				high=ieor(16,high)
				low=ieor(33,low)
c				write(8,*) ' high,low  after xor'
c				write(8,1000) high,low
			endif
		enddo
	enddo
        return
        end
c-----------------------------------------------------------
c	subroutine fincrc
c  finish CRC calculation for sending    result in high, low
c  merely runs updcrc with two  zero bytes
c  NEVER ACTUALLY USED, I JUST PASS TWO EXTRA ZERO BYTES TO UPDCRC WITH SECTOR
c       integer high,low
c       byte highbyte,lowbyte
c       common /crcval/high,low
c	equivalence (high,highbyte)
c	equivalence (low,lowbyte)
c
c	byte=0
c	call updcrc(byte)
c	call updcrc(byte)
c	return
c	end
c-----------------------------------------------------------
	subroutine eat
c  eats extra characters 'til pause   used to re-synch after error
c  in case error was in header, allow at least 1 block of garbage
	parameter numchar=135	! allow a few noise bytes beyond 1 block
	byte buffer(numchar)
	logical i,ttyinlim
c
	parameter maxtime=2

  100	i=ttyinlim(buffer,numchar,maxtime)
c	print *,' eating'
c	write(8,*) 'finished eating'
	if(istat) goto 100	! didn't timeout, so char's still coming
c	print *,' finished eating'
c	write(8,*) ' finished eating'
c	write(8,'(16z5)') buffer
	return
	end
c-----------------------------------------------------------
      LOGICAL FUNCTION TTYINLIM(LINE,N,LIMIT)
      BYTE LINE(*)
      INTEGER N,LIMIT
C              READ CHARACTERS FROM TERMINAL 
C              WITH TIME LIMIT, RETURN FALSE IF NO CHARACTERS
C              RECEIVED FOR LIMIT SECONDS
C              MODIFIED BY BELONIS TO REMOVE PRIVILEGE PROBLEM
C              MAY HAVE PROBLEM WITH TYPE-AHEAD 
c	apparent typeahead problem:  in SENDFN, remote can send checksum
c	too soon after we send EOF, it is seen by typeahead since
c	this routine has not yet activated, so high bit already stripped
c       This was solved by using PASSALL routine.

       INTEGER*2 CHAN,STATUS(4)
       COMMON /QIO/ CHAN,STATUS

      INCLUDE '($SSDEF)'	! defines error status returns
      INTEGER I
      INTEGER SYS$QIOW
      INTEGER*4 terminators(2)
      EXTERNAL IO$M_NOECHO,IO$_TTYREADALL,IO$M_TIMED
      DATA TERMINATORS/0,0/
C 
c	write(8,*) ' inside ttyinlim'
      TTYINLIM=.TRUE.          ! DEFAULT no delay over LIMIT seconds
      I = SYS$QIOW(,           !EVENT FLAG
     -              %VAL(CHAN),         !CHANNEL
     -              %VAL(%LOC(IO$_TTYREADALL).OR. 
     -                   %LOC(IO$M_NOECHO).OR.%LOC(IO$M_TIMED)),
     -              STATUS,,,
     -              LINE,       !BUFFER
     -              %VAL(N),   !LENGTH
     -              %VAL(LIMIT),    !time limit in seconds
     -              terminators,,)  !no terminators 
c      print *,' ttyinlim=',(LINE(j),j=1,N), ' STATUS=',STATUS
c      write(8,*) ' ttyinlim=',(LINE(j),j=1,N), ' STATUS=',STATUS
      if(STATUS(1).EQ.SS$_TIMEOUT) THEN
         TTYINLIM=.FALSE.
c         print *, ' ttyinlim timeout'
         write(8,*) ' ttyinlim timeout'
         return
      ENDIF

      IF (I) THEN
c         print *, ' returning from ttyinlim'
c         write(8,*) ' returning from ttyinlim
         return
      endif
C 
C              ERROR
      write(8,*) ' ttyinlim error.'
      CALL SYS$EXIT( %VAL(I) )
      END 
c-----------------------------------------------------------
      SUBROUTINE TTYOUT(LINE,N) 
      BYTE LINE(*)
      INTEGER*2 N
C  output N characters without interpretation

       INTEGER*2 CHAN,STATUS(4)
       COMMON /QIO/ CHAN,STATUS

      INTEGER I 
      INTEGER SYS$QIOW
      EXTERNAL IO$M_NOFORMAT
      EXTERNAL IO$_WRITEVBLK
C 
      IF( N.LE.0 ) THEN
         WRITE(8,*) ' ttyout called with strange number of char ',N
         RETURN
      ENDIF
C 
c	print *, ' to be sent by ttyout ', (line(i),i=1,n)
c	write(8,*) ' to be sent by ttyout ', (line(i),i=1,n)
      I = SYS$QIOW(,
     -              %VAL(CHAN), 
     -              %VAL(%LOC(IO$_WRITEVBLK).OR.
     -                   %LOC(IO$M_NOFORMAT)),
     -              STATUS,,, 
     -              LINE, 
     -              %VAL(N),, 
     -              %VAL(0),, )         !NO CARRIAGE CONTROL 
      if(I) then
         return
      endif
C 
C              ERROR
      write(8,*) ' ttyout error.'
      CALL SYS$EXIT( %VAL(I) )
      END
c--------------------------------------------------
	subroutine giveup
c  this exit routine used especially in case exited via QIO problem

       INTEGER*2 CHAN,STATUS(4)
       COMMON /QIO/ CHAN,STATUS

c  note: if want log file message, must re-open since
c  system already closed all files before this exit handler got control
c	open(8,file='XMODEM.LOG',access='APPEND')
c	write(8,*) ' Exit handler.'

c  turn off passall
	call passall(CHAN,.FALSE.)
	return
	end
c-----------------------------------------------------
	SUBROUTINE PASSALL(CHAN,SWITCH)
C  sets PASSALL mode for terminal connected to chanel CHAN, ON if switch true
	IMPLICIT INTEGER (A-Z)
	INCLUDE '($TTDEF)'
	INCLUDE '($IODEF)'
	LOGICAL SWITCH
	COMMON/CHAR/CLASS,TYPE,WIDTH,CHARAC(3),LENGTH	!byte reversed LENGTH
	BYTE CLASS,TYPE,CHARAC,LENGTH
	INTEGER*2 WIDTH,SPEED
	EQUIVALENCE(CHARACTER,CHARAC)

c  sense current terminal driver mode
	ISTAT=SYS$QIOW(,%VAL(CHAN),%VAL(IO$_SENSEMODE),,,,
	1 CLASS,,,,,)
	IF (.NOT.ISTAT) CALL ERROR('TERMINAL SENSEMODE',ISTAT)

	IF(SWITCH) THEN
c  turn on 8 bit passall
		CHARACTER=CHARACTER.OR.TT$M_PASSALL.OR.
	1				TT$M_EIGHTBIT
	ELSE
c  turn off 8 bit passall
		CHARACTER=CHARACTER.AND..NOT.TT$M_PASSALL.AND.
	1                               .NOT.TT$M_EIGHTBIT
	ENDIF
	SPEED=0	!LEAVE SPEED UNCHANGED
	PAR=0	!LEAVE PARITY UNCHANGED

c  set terminal mode with desired passall
	ISTAT=SYS$QIOW(,%VAL(CHAN),%VAL(IO$_SETMODE),,,,
	1               CLASS,,%VAL(SPEED),,%VAL(PAR),)
	IF (.NOT.ISTAT) CALL ERROR('TERMINAL SETMODE',ISTAT)
	RETURN
	END
c---------------------------------------------------
	SUBROUTINE ERROR(STRING,MSGID)
c		Types error message
	IMPLICIT INTEGER(A-Z)
	CHARACTER*(*) STRING
	CHARACTER*80 MESSAGE

	TYPE *,' *** ERROR: ',STRING
	write(8,*) ' *** ERROR: ',STRING
	CALL SYS$GETMSG(%VAL(MSGID),MSGLEN,MESSAGE,%VAL(15),)
	TYPE *,MESSAGE(1:MSGLEN),CRLF
	write(8,*) MESSAGE(1:MSGLEN),CRLF
	RETURN
	END
c-----------------------------------------------------------
	subroutine cancel
c  called to cancel send (at least)
	logical ttyinlim
	byte c(135)		! enough space to eat everything
	parameter CAN=24
	parameter SPACE=32

c  eat garbage
  100	if( ttyinlim(c,135,1) ) goto 100
c  cancel other end
	call ttyout(CAN,1)

c  eat garbage again in case it didn't understand ?
  200	if( ttyinlim(c,135,1) ) goto 200
c  clear the CAN from far end's input in case he has already cancelled and so
c	has not yet read it.
c  	???? why ? xmodem50.asm does it

	call ttyout(SPACE,1)

c	print *,' XMODEM program canceled'
	write(8,*)' XMODEM program canceled'
	call exit
	end
c------------------------------------------------------
	subroutine getack(acked)
c  returns .TRUE. if gets ACK 
	logical charintime, ttyinlim, acked
	byte sector(130),c

	integer errorcount
	common /err/errorcount

	parameter ACK=6
	parameter NAK=21
	parameter CAN=24
	parameter errlim=10	! max number of errors
	parameter acklim=15	! seconds to wait for ACK (xmodem.asm uses 10?)
				! but Stern's Northstar takes longer
				! to write 128 sectors

c	print *,' inside getack'
c	write(8,*) ' inside getack'
c  empty typeahead in case garbage
c	charintime=ttyinlim(sector,130,0)

c  allow time for disk file write at other end.  Typically 128 sectors.
c						Sometimes only 1 track.
10	charintime=ttyinlim(c,1,acklim)
c	print *,' getack got',c
c	write(8,*) ' getack got',c

	if( .NOT.charintime ) then
c		print *, ' timeout in GETACK'		
		write(8,*) ' timeout in GETACK'		
		errorcount=errorcount+1
		if(errorcount.GE.errlim) then
			write(8,*) ' not acknowleged in 10 tries.'
c			print *,' Can''t send sector. Aborting.'
			call cancel
		endif
		goto 10		! try again
	elseif( c.EQ.ACK ) then
c  received ACK
		acked=.TRUE.
	elseif( c.EQ.NAK ) then
c		print *,' not ACK, decimal=',c
		write(8,*) ' not ACK, decimal=',c
		errorcount=errorcount+1
		if(errorcount.GE.errlim) then
			write(8,*) ' not acknowleged in 10 tries.'
c			print *,' Can''t send sector. Aborting.'
			call cancel
		endif
		acked=.FALSE.

	elseif(c.EQ.CAN) then 
		write (8,*) 'Cancel received while waiting for ACK'
		call cancel
	else
c  received garbage, ignore it and try again.
c  note: this risks seeing ACK inside the burst of garbage, possibly should EAT
c		print *, ' not ACK, decimal=',c
		write(8,*) ' not ACK, decimal=',c
		goto 10
	endif
	return
	end
